home *** CD-ROM | disk | FTP | other *** search
/ Mac Magazin/MacEasy 32 / Mac Magazin and MacEasy Magazine CD - Issue 32.iso / Grafik & Text / OzTeX3.0 / Metafont / Inputs / ec / exbase.mf < prev    next >
Text File  |  1997-03-16  |  52KB  |  1,342 lines
  1. % exbase.mf
  2. %
  3. % (c) Copyright 1995, 1996, 1997 J"org Knappen
  4. % (c) Copyright 1990, 1992 Norbert Schwarz
  5. %
  6. % This file is part of ecfonts version 1.0
  7. %
  8. % Please read the files 00readme.txt, 00inst.txt, 00error.txt, and
  9. % copyrite.txt for further information
  10. %
  11. % You find some documentation in ecdoc.tex (needs LaTeX2e)
  12. %
  13. % Content:
  14. %
  15. %   The base file needed for generation of the EC fonts
  16.  
  17. exbase:=1; % if |exbase| is known, this file has been input
  18.  
  19. ec_maj_version:=1; ec_min_version:=0; % version identification
  20.  
  21. def version_check(expr e,f)=
  22.  if    e=ec_maj_version: 
  23.    if  f=ec_min_version: 
  24.      message " Ok";
  25.    elseif: f>ec_min_version: 
  26.      message "ec font warning: Obsolete base";
  27.    elseif: f<ec_min_version: 
  28.      message "ec font warning: File from old release found";
  29.    fi
  30.  elseif: e>ec_maj_version: 
  31.    message "ec font warning: Obsolete base";
  32.  elseif: e<ec_maj_version: 
  33.    message "ec font warning: File from old release found";
  34.  fi
  35. enddef;
  36.  
  37. let stop_eventually=relax;
  38.  
  39. % The following checks require, that |bye| is an |inner| command.
  40. % This is usually set by |local.mf| or |modes.mf|, however we cannot
  41. % rely on this feature, therefore we do it here again.
  42.  
  43. inner bye;
  44.  
  45. % Check for existence of |boundarychar| 
  46. if unknown boundarychar:
  47.  message "You are using out-of-date METAFONT 1.*,";
  48.  message "please update to METFONT 2.718 or newer.";
  49.  let stop_eventually=bye;
  50. fi
  51.  
  52. % Check for old version of |plain.mf| (2.0 or older)
  53. if known begingroup killtext whatever endgroup:
  54.   relax;
  55. else:
  56.   message "You are using plain.mf 2.0 or older";
  57.   message "please update to plain.mf 2.71 or newer";
  58.   let stop_eventually=bye;
  59. fi
  60.  
  61. % Check for |cmbase|
  62. if known cmbase:
  63.   message "You are using METAFONT with cmbase preloaded,";
  64.   message "please use only plain METAFONT to generate the ec fonts.";
  65.   let stop_eventually=bye;
  66. fi
  67.  
  68. stop_eventually;
  69.  
  70. boolean slitex; slitex := false; % |true| simulates behaviour of |sroman|
  71. boolean one_serif; one_serif:=true; % |false| suppresses base serif on `1'
  72. boolean classic_serif;  classic_serif := false;
  73. boolean suppress_i_dot; suppress_i_dot :=false;
  74. boolean hach_sharp; hach_sharp:=false;
  75. boolean classic_sharp_s; classic_sharp_s:=false; % Chooses shape of sharp s
  76. boolean true_mono; true_mono:=false; % |true| forces ligatures to monowidth
  77. boolean knuthian_ae; knuthian_ae:=false; % |true| reproduces cm italic \ae
  78. boolean fancy_thorn; fancy_thorn:=false; % |true| produces \th with fancier bulb
  79. boolean is_small_cap; is_small_cap:=false;
  80. tracingstats:=1; % Print statistics at the end of run
  81.  
  82. let ecchar=\; % `|ecchar|' should precede each character
  83. let generate=input; % `|generate|' should follow the parameters
  84.  
  85. autorounding:=0; smoothing:=0; % we do our own rounding
  86. def autorounded = interim autorounding:=2 enddef;
  87.  
  88. newinternal slant,fudge,math_spread,superness,superpull,beak_darkness;
  89. boolean square_dots,hefty,serifs,
  90.  monospace,variant_g,low_asterisk,math_fitting;
  91.  
  92. boolean dark,dark.dark,skewed,skewed.skewed; % for fast option testing
  93. dark=skewed=false; dark.dark=skewed.skewed=true;
  94.  
  95. vardef Vround primary y = y_:=vround y;
  96.  if y_<min_Vround: min_Vround else: y_ fi enddef;
  97. newinternal y_,min_Vround;
  98.  
  99. vardef serif(suffix $,$$,@)  % serif at |z$| for stroke from |z$$|
  100.   (expr darkness,jut) suffix modifier =
  101.  pickup crisp.nib; numeric bracket_height; pair downward;
  102.  bracket_height=if dark.modifier: 1.5 fi\\ bracket;
  103.  if y$<y$$: y@2=min(y$+bracket_height,y$$);
  104.   top y@1-slab=bot y@0+eps=tiny.bot y$; downward=z$-z$$;
  105.   if y@1>y@2: y@2:=y@1; fi
  106.  else: y@2=max(y$-bracket_height,y$$);
  107.   bot y@1+slab=top y@0-eps=tiny.top y$; downward=z$$-z$;
  108.   if y@1<y@2: y@2:=y@1; fi fi
  109.  y@3=y@2; z@3=whatever[z$,z$$];
  110.  if jut<0: z@2+penoffset downward of currentpen =
  111.    z$l+penoffset downward of pen_[tiny.nib]+whatever*downward;
  112.   lft x@0=lft x@1=tiny.lft x$l+jut;
  113.   if x@3<x@2+eps: x@3:=x@2+eps; fi
  114.  else: z@2-penoffset downward of currentpen =
  115.    z$r-penoffset downward of pen_[tiny.nib]+whatever*downward;
  116.    rt x@0=rt x@1=tiny.rt x$r+jut;
  117.    if x@3>x@2-eps: x@3:=x@2-eps; fi fi
  118.  pair corner; ypart corner=y@1; corner=z@2+whatever*downward;
  119.  filldraw z@2{z$-z$$}
  120.   ...darkness[corner,.5[z@1,z@2] ]{z@1-z@2}
  121.   ...{jut,0}z@1--z@0--(x$,y@0)--z@3--cycle; % the serif
  122.  labels (@1,@2); enddef;
  123.  
  124. def dish_serif(suffix $,$$,@)(expr left_darkness,left_jut)
  125.   (suffix @@)(expr right_darkness,right_jut) suffix modifier =
  126.  serif($,$$,@,left_darkness,-left_jut) modifier;
  127.  serif($,$$,@@,right_darkness,right_jut) modifier;
  128.  if dish>0: pickup tiny.nib; numeric dish_out,dish_in;
  129.   if y$<y$$: dish_out=bot y$; dish_in=dish_out+dish; let rev_=reverse;
  130.   else: dish_out=top y$; dish_in=dish_out-dish; let rev_=relax; fi
  131.   erase fill rev_
  132.    ((x@1,dish_out)..(x$,dish_in){right}..(x@@1,dish_out)--cycle);
  133.  fi enddef;
  134.  
  135. def nodish_serif(suffix $,$$,@)(expr left_darkness,left_jut)
  136.   (suffix @@)(expr right_darkness,right_jut) suffix modifier =
  137.  serif($,$$,@,left_darkness,-left_jut) modifier;
  138.  serif($,$$,@@,right_darkness,right_jut) modifier; enddef;
  139.  
  140. vardef sloped_serif.l(suffix $,$$,@)(expr darkness,jut,drop) =
  141.  pickup crisp.nib; pos@2(slab,90);
  142.  lft x@0=tiny.lft x$l; rt x@1=tiny.rt x$r; top y@1=tiny.top y$r;
  143.  lft x@2=lft x@0-jut; y@2r=y@1-drop;
  144.  y@0=max(y@2l-bracket,y$$)-eps;
  145.  if drop>0: erase fill z@1--top z@1
  146.    --(x@2r,top y@1)--z@2r--cycle; fi % erase excess at top
  147.  filldraw z@1--z@2r--z@2l{right}
  148.   ...darkness[(x@0,y@2l),.5[z@2l,z@0] ]{z@0-z@2l}
  149.   ...{down}z@0--(x@1,y@0)--cycle;  % sloped serif
  150.  labels(@0,@1,@2); enddef;
  151.  
  152. vardef sloped_serif.r(suffix $,$$,@)(expr darkness,jut,drop) =
  153.  pickup crisp.nib; pos@2(slab,-90);
  154.  rt x@0=tiny.rt x$r; lft x@1=tiny.lft x$l; bot y@1=tiny.bot y$l;
  155.  rt x@2=rt x@0+jut; y@2r=y@1+drop;
  156.  y@0=min(y@2l+bracket,y$$)+eps;
  157. if drop>0: erase fill z@1--bot z@1
  158.   --(x@2r,bot y@1)--z@2r--cycle; fi % erase excess at bottom
  159.  filldraw z@1--z@2r--z@2l{left}
  160.   ...darkness[(x@0,y@2l),.5[z@2l,z@0] ]{z@0-z@2l}
  161.   ...{up}z@0--(x@1,y@0)--cycle;  % sloped serif
  162.  labels(@0,@1,@2); enddef;
  163.  
  164. vardef term.l(suffix $,$$)(expr d,t,s)= % ``robust'' sans-serif terminal
  165.  path p_; p_=z$l{d}..tension t..z$$l;
  166.  pair d_; d_=(x$$l-x$l,s*(y$$l-y$l));
  167.  if (abs angle direction 1 of p_ < abs angle d_)<>(x$l<x$$l):
  168.   p_:=z$l{d}..tension atleast t..{d_}z$$l; fi
  169.  p_ enddef;
  170. vardef term.r(suffix $,$$)(expr d,t,s)=
  171.  path p_; p_=z$r{d}..tension t..z$$r;
  172.  pair d_; d_=(x$$r-x$r,s*(y$$r-y$r));
  173.  if (abs angle direction 1 of p_ < abs angle d_)<>(x$r<x$$r):
  174.   p_:=z$r{d}..tension atleast t..{d_}z$$r; fi
  175.  p_ enddef;
  176. def rterm=reverse term enddef;
  177.  
  178. vardef arm(suffix $,$$,@)(expr darkness,jut) =  % arm from |z$| to |z$$|
  179.  x@0=good.x(x$$r-jut); y@0=y$r;
  180.  if serifs: y@1=y$l; z@1=z$$l+whatever*(z$$r-z@0);
  181.   z@2=.5[z$l,z@1];
  182.   filldraw z$$l{z@1-z$$l}...darkness[z@1,.5[z@2,z$$l] ]...z@2
  183.    ---z$l--z$r--z@0--z$$r--cycle; % arm and beak
  184.  else: filldraw z$l--z$r--z@0--z$$r--cycle; fi  % sans-serif arm
  185.  penlabels(@0,@1,@2); enddef;
  186.  
  187. def bulb(suffix $,$$,$$$) =
  188.  z$$$r=z$$r;
  189.  path_.l:=z$l{x$$r-x$r,0}...{0,y$$r-y$r}z$$l;
  190.  filldraw path_.l--z$$r{0,y$r-y$$r}...{x$r-x$$r,0}z$r--cycle; % link
  191.  path_.r:=z$$$l{0,y$r-y$$r}..z$$$r{0,y$$r-y$r}; % near-circle
  192.  filldraw subpath(0,xpart(path_.r intersectiontimes path_.l)) of path_.r
  193.   --z$$r{0,y$$r-y$r}..cycle; % bulb
  194.  enddef;
  195.  
  196. def v_bulb(suffix $,$$)= % |pos$| is known
  197.  y$$+.5curve=x_height+oo; x$$+.5curve=w-u;
  198.  numeric theta; theta=angle(4(x$-x$$),y$-y$$); pos$$(curve,theta+90);
  199.  filldraw z$$l{dir theta}..tension atleast 1 and 1..{down}z$l
  200.   --z$r{up}...{-dir theta}z$$r..cycle;  % bulb
  201.  enddef;
  202.  
  203. def dot(suffix $,$$) =
  204.  filldraw if square_dots: (x$l,y$$l)--(x$r,y$$l)
  205.    --(x$r,y$$r)--(x$l,y$$r)--cycle  % squarish dot
  206.   else: z$l...z$$l...z$r...z$$r...cycle  fi % roundish dot
  207.  enddef;
  208.  
  209. def comma(suffix $,@)(expr dot_size,jut,depth) =
  210.  pickup fine.nib; pos$(dot_size,90);
  211.  if square_dots: pos$'(dot_size,0); z$'=z$; dot($',$);  % squarish dot
  212.   comma_join_:=max(fine.breadth,floor .7dot_size);
  213.   comma_bot_:=max(fine.breadth,floor .5dot_size);
  214.   pos@0(comma_join_,0); pos@1(comma_join_,0);
  215.   pos@2(comma_bot_,0); y@0=y$; y@1=y$l; y@2=y@1-depth;
  216.   x@0r=x@1r=x$'r; rt x@2r=good.x(x$-eps);
  217.   filldraw stroke z@0e--z@1e..z@2e;  % tail
  218.  else: pos@1(vair,90); pos@2(vair,0); pos@3(vair,-45);
  219.   z@1r=z$r; rt x@2r=hround(x$+.5dot_size+jut)+2eps; x@3=x$-.5u;
  220.   y@2=1/3[y@1,y@3]; bot y@3r=vround(y$-.5dot_size-depth);
  221.   y_:=ypart((z@1{right}...z@2{down}...z@3)
  222.    intersectiontimes (z$l{right}..{left}z$r)); if y_<0: y_:=1; fi
  223.   filldraw z$r{left}..subpath (0,y_) of (z$l{right}..{left}z$r)--cycle; % dot
  224.   filldraw stroke z@1e{right}...z@2e{down}...z@3e; fi  % tail
  225.  penlabels(@1,@2,@3); enddef;
  226.  
  227. def ammoc(suffix $,@)(expr dot_size,jut,depth) = % reversed comma
  228.  pickup fine.nib; pos$(dot_size,90);
  229.  if square_dots: pos$'(dot_size,0); z$'=z$; dot($',$);  % squarish dot
  230.   comma_join_:=max(fine.breadth,floor .7dot_size);
  231.   comma_top_:=max(fine.breadth,floor .5dot_size);
  232.   pos@0(comma_join_,0); pos@1(comma_join_,0);
  233.   pos@2(comma_top_,0); y@0=y$; y@1=y$r; y@2=y@1+depth;
  234.   x@0l=x@1l=x$'l; lft x@2l=good.x(x$+eps);
  235.   filldraw stroke z@0e--z@1e..z@2e;  % tail
  236.  else: pos@1(vair,90); pos@2(vair,0); pos@3(vair,-45);
  237.   z@1l=z$l; lft x@2l=hround(x$-.5dot_size-jut)-2eps; x@3=x$+.5u;
  238.   y@2=1/3[y@1,y@3]; top y@3l=vround(y$+.5dot_size+depth);
  239.   y_:=ypart((z@1{left}...z@2{up}...z@3)
  240.    intersectiontimes (z$r{left}..{right}z$l)); if y_<0: y_:=1; fi
  241.   filldraw z$l{right}..subpath (0,y_) of (z$r{left}..{right}z$l)--cycle; % dot
  242.   filldraw stroke z@1e{left}...z@2e{up}...z@3e; fi  % tail
  243.  penlabels(@1,@2,@3); enddef;
  244.  
  245. %%% @ from to %%%% temporary formatting change
  246. vardef diag_in(suffix from,$)(expr sharpness)(suffix $$) =
  247.  pickup tiny.nib; save from_x,y_;
  248.  if y.from>y$: bot else: top fi\\ y_=y$;
  249.  (from_x,y_)=whatever[z.from,z$];
  250.  sharpness[z$,(from_x,y_)]{z$-z.from}
  251.   ...{z$$-z$}z$+sharpness*length(z$-(from_x,y_))*unitvector(z$$-z$) enddef;
  252.  
  253. vardef diag_out(suffix $)(expr sharpness)(suffix $$,to) =
  254.  pickup tiny.nib; save to_x,y_;
  255.  if y.to>y$: bot else: top fi\\ y_=y$;
  256.  (to_x,y_)=whatever[z$$,z.to];
  257.  z$$-sharpness*length(z$$-(to_x,y_))*unitvector(z$$-z$){z$$-z$}
  258.   ...{z.to-z$$}sharpness[z$$,(to_x,y_)] enddef;
  259.  
  260. vardef diag_end(suffix from,$)(expr sharpness_in,sharpness_out)(suffix $$,to)=
  261.  save from_x,to_x,y_,x_,xx_;
  262.  if y.from>y$: tiny.bot else: tiny.top fi\\ y_=y$; % we assume that |y$=y$$|
  263.  (from_x,y_)=whatever[z.from,z$]; (to_x,y_)=whatever[z$$,z.to];
  264.  if x$$>x$: x_=x$+sharpness_in*length(z$-(from_x,y_));
  265.   xx_=x$$-sharpness_out*length(z$$-(to_x,y_));
  266.   if xx_<x_: xx_:=x_:=.5[xx_,x_]; fi
  267.  else: x_=x$-sharpness_in*length(z$-(from_x,y_));
  268.   xx_=x$$+sharpness_out*length(z$$-(to_x,y_));
  269.   if xx_>x_: xx_:=x_:=.5[xx_,x_]; fi fi
  270.  sharpness_in[z$,(from_x,y_)]{z$-z.from}
  271.   ...{z$$-z$}(x_,y$)..(xx_,y$){z$$-z$}
  272.   ...{z.to-z$$}sharpness_out[z$$,(to_x,y_)] enddef;
  273. %%% at from to %%%% restore normal formatting
  274.  
  275. vardef special_diag_end(suffix $$,$,@,@@) = % for top middle of w's
  276.  if x@r<=x$r: diag_end($$r,$r,1,1,@l,@@l)
  277.  else: z0=whatever[z$$l,z$l]=whatever[z@l,z@@l];
  278.   diag_end($$r,$r,1,1,$l,0)--z0 fi enddef;
  279.  
  280. def prime_points_inside(suffix $,$$) =
  281.  theta_:=angle(z$r-z$l);
  282.  penpos$'(whatever,theta_);
  283.  if y$$>y$: z$'=(0,pen_top) rotated theta_ + whatever[z$l,z$r];
  284.   theta_:=angle(z$$-z$)-90;
  285.  else: z$'=(0,pen_bot) rotated theta_ + whatever[z$l,z$r];
  286.   theta_:=angle(z$$-z$)+90; fi
  287.  z$'l+(pen_lft,0) rotated theta_=z$l+whatever*(z$-z$$);
  288.  z$'r+(pen_rt,0) rotated theta_=z$r+whatever*(z$-z$$);
  289.  enddef;
  290.  
  291. def ellipse_set(suffix $,@,@@,$$) = % given |z$,x@,z$$|, find |y@| and |z@@|
  292. % such that the path |z${x@-x$,0}..z@{0,y@-y$}..{z$$-z@@}z@@|
  293. % is consistent with an ellipse
  294. % and such that the line |z@@--z$$| has a given |slope|
  295.  alpha_:=slope*(x@-x$); beta_:=y$$-y$-slope*(x$$-x$);
  296.  gamma_:=alpha_/beta_;
  297.  y@-y$=.5(beta_-alpha_*gamma_);
  298.  x@@-x$=-2gamma_*(x@-x$)/(1+gamma_*gamma_);
  299.  y@@-y$$=slope*(x@@-x$$) enddef;
  300.  
  301. vardef diag_ratio(expr a,b,y,c) = % assuming that $a>\vert b/y\vert$,
  302. % compute the value $\alpha=(x\6{++}y)/y$ such that $ax+b\alpha=c$
  303.  numeric a_,b_; b_=b/y; a_=a*a-b_*b_;
  304.  (a*(c++y*sqrt a_)-b_*c)/a_/y enddef;
  305.  
  306. def f_stroke(suffix $,$$,@,left_serif,right_serif)(expr left_jut,right_jut)=
  307.  pickup tiny.nib; bot y$=0;
  308.  penpos@0(x$r-x$l,0); x@0l=x$l; top y@0=x_height;
  309.  filldraw stroke z$e--z@0e;  % stem
  310.  pickup fine.nib; pos@0'(x$r-x$l-(hround stem_corr)+tiny,180);
  311.  y@0'=y@0; lft x@0'r=tiny.lft x$l;
  312.  penpos@1(x@0'l-x@0'r,180); x@1=x@0'; y@1+.5vair=.5[x_height,h];
  313.  pos@2(vair,90); top y@2r=h+oo;
  314.  if serifs: x@2=.6[x@1,x$$r]; (x@,y@2r)=whatever[z@2l,z@1l];
  315.   x@2r:=min(x@,.5[x@2,x$$r]); pos@3(hair,0); bulb(@2,@3,$$);  % bulb
  316.   filldraw stroke z@0'e--z@1e & super_arc.e(@1,@2);  % arc
  317.   dish_serif($,@0,left_serif,1/3,left_jut,right_serif,1/3,right_jut); % serif
  318.  else: x@2=.6[x@1,x$$]; y@1l:=1/3[y@1l,y@2l];
  319.   filldraw stroke z@0'e--z@1e & super_arc.e(@1,@2)
  320.    & term.e(@2,$$,right,.9,4); fi  % arc and terminal
  321.  penlabels(@0,@1,@2); enddef;
  322.  
  323. def h_stroke(suffix $,@,@@,$$) =
  324.  penpos$$(x@@r-x@@l,0); x$$=x@@; bot y$$=0;
  325.  y@@=1/3[bar_height,x_height];
  326.  penpos$''(x$r-x$l,0); x$''=x$; y$''=1/8[bar_height,x_height];
  327.  filldraw stroke z$''e--z$e;  % thicken the lower left stem
  328.  penpos@0(min(rt x$r-lft x$l,thin_join)-fine,180); pickup fine.nib;
  329.  rt x@0l=tiny.rt x$r; y@0=y$'';
  330.  pos@1(vair,90); pos@@'(x@@r-x@@l+tiny,0); z@@'=z@@;
  331.  x@1=.5[rt x@0l,rt x@@'r]; top y@1r=x_height+oo;
  332.  (x@,y@1l)=whatever[z@1r,z@0l]; x@1l:=x@;
  333.  filldraw stroke z@0e{up}...{right}z@1e
  334.   &{{interim superness:=hein_super; super_arc.e(@1,@@')}};  % arch
  335.  pickup tiny.nib; filldraw stroke z@@e--z$$e;  % right stem
  336.  labels(@0); penlabels(@1); enddef;
  337.  
  338. def hook_out(suffix $,$$,$$$)suffix modifier= % |x$| and |x$$$| (only) are known
  339.  pos$(stem,0); pos$$(vair,90);
  340.  x$$$:=hround(x$$$+.5hair-eps)-.5hair; pos$$$(hair,180);
  341.  y$=1/4x_height; bot y$$l=-oo; y$$$=1/3x_height;
  342.  if skewed.modifier: x$$=x$+1.25u;
  343.   filldraw stroke z$e{-u,-x_height}...z$$e{right}...{up}z$$$e;  % hook
  344.  else: x$$=x$+1.5u;
  345.   filldraw stroke z$e{down}...z$$e{right}
  346.    ...{x$$$-(x$+2.5u),x_height}z$$$e; fi enddef;  % hook
  347.  
  348. def empty_hook_out(suffix $,$$,$$$)suffix modifier= % |x$| and |x$$$| (only) are known
  349.  pos$(stem,0); pos$$(vair,90);
  350.  x$$$:=hround(x$$$+.5hair-eps)-.5hair; pos$$$(hair,180);
  351.  y$=1/4x_height; bot y$$l=-oo; y$$$=1/3x_height;
  352.  if skewed.modifier: x$$=x$+1.25u;
  353. %  filldraw stroke z$e{-u,-x_height}...z$$e{right}...{up}z$$$e;  % hook
  354.  else: x$$=x$+1.5u;
  355. %  filldraw stroke z$e{down}...z$$e{right}
  356. %   ...{x$$$-(x$+2.5u),x_height}z$$$e;
  357. fi enddef;  % empty_hook_out
  358.  
  359. def hook_in(suffix $,$$,$$$)suffix modifier= % |x$| and |x$$$| (only) are known
  360.  x$:=hround(x$-.5hair)+.5hair; pos$(hair,180);
  361.  pos$$(vair,90); pos$$$(stem,0);
  362.  y$=2/3x_height; top y$$r=x_height+oo; y$$$=3/4x_height;
  363.  if skewed.modifier: x$$=x$$$-1.25u;
  364.   filldraw stroke z$e{up}...z$$e{right}...{-u,-x_height}z$$$e;  % hook
  365.  else: x$$=x$$$-1.5u;
  366.   filldraw stroke z$e{x$$$-2.5u-x$,x_height}
  367.    ...z$$e{right}...{down}z$$$e; fi enddef;  % hook
  368.  
  369. def ital_arch(suffix $,$$,$$$) = % |z$| and |z$$$| (only) are known
  370.  pos$'(hair,180); z$'=z$;
  371.  pos$$(vair,90); pos$$$(stem,0);
  372.  {{interim superness := more_super; x$$=.6[x$,x$$$];
  373.  top y$$r=x_height+oo; y$$$=.65x_height;
  374.  filldraw stroke z$'e{up}...super_arc.e($$,$$$);}} enddef;  % stroke
  375.  
  376. def compute_spread(expr normal_spread,big_spread)=
  377.  spread#:=math_spread[normal_spread,big_spread];
  378.  spread:=ceiling(spread#*hppp)+eps; enddef;
  379.  
  380. def v_center(expr h_sharp) =
  381.  .5h_sharp+math_axis#, .5h_sharp-math_axis# enddef;
  382.  
  383. def circle_points =
  384.  x4=x8=.5[x2,x6]; x1=x3=superness[x4,x2]; x5=x7=superness[x4,x6];
  385.  y2=y6=.5[y4,y8]; y1=y7=superness[y2,y8]; y3=y5=superness[y2,y4];
  386.  enddef;
  387. def draw_circle =
  388.  draw z8{right}...z1{z2-z8}...z2{down}...z3{z4-z2}...z4{left}
  389.   ...z5{z6-z4}...z6{up}...z7{z8-z6}...cycle enddef;
  390.  
  391. def left_paren(expr min_breadth, max_breadth) =
  392.  pickup fine.nib; pos1(hround min_breadth,0);
  393.  pos2(hround max_breadth,0); pos3(hround min_breadth,0);
  394.  rt x1r=rt x3r=hround(w-1.25u+.5min_breadth); lft x2l=hround 1.25u;
  395.  top y1=h; y2=.5[y1,y3]; bot y3=1-d;
  396.  filldraw stroke z1e{3(x2e-x1e),y2-y1}...z2e
  397.   ...{3(x3e-x2e),y3-y2}z3e;  % arc
  398.  penlabels(1,2,3); enddef;
  399.  
  400. def right_paren(expr min_breadth, max_breadth) =
  401.  pickup fine.nib; pos1(hround min_breadth,0);
  402.  pos2(hround max_breadth,0); pos3(hround min_breadth,0);
  403.  lft x1l=lft x3l=hround(1.25u-.5min_breadth); rt x2r=hround(w-1.25u);
  404.  top y1=h; y2=.5[y1,y3]; bot y3=1-d;
  405.  filldraw stroke z1e{3(x2e-x1e),y2-y1}...z2e
  406.   ...{3(x3e-x2e),y3-y2}z3e;  % arc
  407.  penlabels(1,2,3); enddef;
  408.  
  409. def left_bracket(expr breadth,do_top,do_bot) =
  410.  pickup crisp.nib;
  411.  numeric thickness; thickness=hround breadth;
  412.  pos1(thickness,0); pos2(thickness,0);
  413.  top y1=h; bot y2=1-d; lft x1l=lft x2l=hround(2.5u-.5thickness);
  414.  filldraw stroke z1e--z2e;  % stem
  415.  pos3(thickness,90); pos4(thickness,90);
  416.  pos5(thickness,90); pos6(thickness,90);
  417.  x3=x5=x1l; rt x4=rt x6=hround(w-.75u+.5thickness);
  418.  y3r=y4r=y1; y5l=y6l=y2;
  419.  if do_top: filldraw stroke z3e--z4e; fi  % upper bar
  420.  if do_bot: filldraw stroke z5e--z6e; fi  % lower bar
  421.  penlabels(1,2,3,4,5,6); enddef;
  422.  
  423. def right_bracket(expr breadth,do_top,do_bot) =
  424.  pickup crisp.nib;
  425.  numeric thickness; thickness=hround breadth;
  426.  pos1(thickness,0); pos2(thickness,0);
  427.  top y1=h; bot y2=1-d; rt x1r=rt x2r=hround(w-2.5u+.5thickness);
  428.  filldraw stroke z1e--z2e;  % stem
  429.  pos3(thickness,90); pos4(thickness,90);
  430.  pos5(thickness,90); pos6(thickness,90);
  431.  x3=x5=x1r; lft x4=lft x6=hround(.75u-.5thickness);
  432.  y3r=y4r=y1; y5l=y6l=y2;
  433.  if do_top: filldraw stroke z3e--z4e; fi  % upper bar
  434.  if do_bot: filldraw stroke z5e--z6e; fi  % lower bar
  435.  penlabels(1,2,3,4,5,6); enddef;
  436.  
  437. def left_curly(expr min_breadth, max_breadth) =
  438.  pickup fine.nib;
  439.  forsuffixes $=1,1',4,4',7,7': pos$(hround min_breadth,0); endfor
  440.  forsuffixes $=2,3,5,6: pos$(hround max_breadth,0); endfor
  441.  x2=x3=x5=x6; x1=x1'=x7=x7'=w-x4=w-x4';
  442.  lft x4l=hround(1.5u-.5min_breadth); lft x2l=hround(.5w-.5max_breadth);
  443.  top y1=h; bot y7=1-d; .5[y4,y4']=.5[y1,y7]=.5[y2,y6]=.5[y3,y5];
  444.  y1-y2=y3-y4=(y1-y4)/4;
  445.  y1-y1'=y4-y4'=y7'-y7=vround(min_breadth-fine);
  446.  filldraw z1l{3(x2l-x1l),y2-y1}...z2l---z3l...{3(x4l-x3l),y4-y3}z4l
  447.   --z4'l{3(x5l-x4l),y5-y4'}...z5l---z6l...{3(x7l-x6l),y7-y6}z7l
  448.   --z7r--z7'r{3(x6r-x7r),y6-y7'}...z6r---z5r
  449.   ...{3(x4r-x5r),.5[y4,y4']-y5}.5[z4r,z4'r]{3(x3r-x4r),y3-.5[y4,y4']}
  450.   ...z3r---z2r...{3(x1r-x2r),y1'-y2}z1'r--z1r--cycle;  % stroke
  451.  penlabels(1,2,3,4,5,6,7); enddef;
  452.  
  453. def right_curly(expr min_breadth, max_breadth) =
  454.  pickup fine.nib;
  455.  forsuffixes $=1,1',4,4',7,7': pos$(hround min_breadth,0); endfor
  456.  forsuffixes $=2,3,5,6: pos$(hround max_breadth,0); endfor
  457.  x2=x3=x5=x6; x1=x1'=x7=x7'=w-x4=w-x4';
  458.  lft x1l=hround(1.5u-.5min_breadth); lft x2l=hround(.5w-.5max_breadth);
  459.  top y1=h; bot y7=1-d; .5[y4,y4']=.5[y1,y7]=.5[y2,y6]=.5[y3,y5];
  460.  y1-y2=y3-y4=(y1-y4)/4;
  461.  y1-y1'=y4-y4'=y7'-y7=vround(min_breadth-fine);
  462.  filldraw z1r{3(x2r-x1r),y2-y1}...z2r---z3r...{3(x4r-x3r),y4-y3}z4r
  463.   --z4'r{3(x5r-x4r),y5-y4'}...z5r---z6r...{3(x7r-x6r),y7-y6}z7r
  464.   --z7l--z7'l{3(x6l-x7l),y6-y7'}...z6l---z5l
  465.   ...{3(x4l-x5l),.5[y4,y4']-y5}.5[z4l,z4'l]{3(x3l-x4l),y3-.5[y4,y4']}
  466.   ...z3l---z2l...{3(x1l-x2l),y1'-y2}z1'l--z1l--cycle;  % stroke
  467.  penlabels(1,2,3,4,5,6,7); enddef;
  468.  
  469. def left_angle(expr breadth) =
  470.  pickup pencircle scaled breadth;
  471.  x1=x3=good.x(w-u)+eps; lft x2=hround u-eps;
  472.  top y1=h+eps; .5[y1,y3]=y2=good.y .5[-d+eps,h];
  473.  draw z1--z2--z3;  % diagonals
  474.  labels(1,2,3); enddef;
  475.  
  476. def right_angle(expr breadth) =
  477.  pickup pencircle scaled breadth;
  478.  x1=x3=good.x u-eps; rt x2=hround(w-u)+eps;
  479.  top y1=h+eps; .5[y1,y3]=y2=good.y .5[-d+eps,h];
  480.  draw z1--z2--z3;  % diagonals
  481.  labels(1,2,3); enddef;
  482.  
  483. def beginarithchar(expr c) = % ensure consistent dimensions for $+$, $-$, etc.
  484.  if monospace: beginchar(c,14u#,27/7u#+math_axis#,27/7u#-math_axis#);
  485.  else: beginchar(c,14u#,6u#+math_axis#,6u#-math_axis#); fi
  486.  italcorr math_axis#*slant-.5u#;
  487.  adjust_fit(0,0); enddef;
  488.  
  489. def center_on(expr x) = if not monospace: % change width for symmetric fit
  490.  r:=r+2x-w; w:=2x; fi enddef;
  491.  
  492. def super_crescent(suffix i,j,k) =
  493.  draw z.i{x.j-x.i,0}
  494.  ... (.8[x.i,x.j],.8[y.j,y.i]){z.j-z.i}
  495.  ... z.j{0,y.k-y.i}
  496.  ... (.8[x.k,x.j],.8[y.j,y.k]){z.k-z.j}
  497.  ... z.k{x.k-x.j,0} enddef;
  498.  
  499. newinternal l,r,shrink_fit; % adjustments to spacing
  500.  
  501. def do_expansion(expr expansion_factor) =
  502.  forsuffixes $=u,jut,cap_jut,beak_jut,apex_corr:
  503.    $:=$.#*expansion_factor*hppp; endfor
  504. enddef;
  505.  
  506. def normal_adjust_fit(expr left_adjustment,right_adjustment) =
  507.  numeric charwd_in; charwd_in=charwd;
  508.  l:=-hround(left_adjustment*hppp)-letter_fit;
  509.  interim xoffset:=-l;
  510.  charwd:=charwd+2letter_fit#+left_adjustment+right_adjustment;
  511.  r:=l+hround(charwd*hppp)-shrink_fit;
  512.  w:=r-hround(right_adjustment*hppp)-letter_fit;
  513.  do_expansion(w/(charwd_in*hppp));
  514.  enddef;
  515.  
  516. def mono_adjust_fit(expr left_adjustment,right_adjustment) =
  517.  numeric charwd_in; charwd_in=charwd;
  518.  numeric expansion_factor;
  519.  mono_charwd#=2letter_fit#
  520.    +expansion_factor*(charwd+left_adjustment+right_adjustment);
  521.  l:=-hround(left_adjustment*expansion_factor*hppp)-letter_fit;
  522.  interim xoffset:=-l;
  523.  r:=l+mono_charwd-shrink_fit;
  524.  w:=r-hround(right_adjustment*expansion_factor*hppp)-letter_fit;
  525.  charwd:=mono_charwd#; charic:=mono_charic#;
  526.  do_expansion(w/(charwd_in*hppp));
  527.  enddef;
  528.  
  529. extra_endchar:=extra_endchar&"r:=r+shrink_fit;w:=r-l;";
  530.  
  531. def ignore_math_fit(expr left_adjustment,right_adjustment) = enddef;
  532. def do_math_fit(expr left_adjustment,right_adjustment) =
  533.  l:=l-hround(left_adjustment*hppp); interim xoffset:=-l;
  534.  charwd:=charwd+left_adjustment+right_adjustment;
  535.  r:=l+hround(charwd*hppp)-shrink_fit;
  536.  charic:=charic-right_adjustment;
  537.  if charic<0: charic:=0; fi enddef;
  538. def zero_width = charwd:=0; r:=l-shrink_fit enddef;
  539. def change_width = if not monospace: % change width by $\pm1$
  540.  if r+shrink_fit-l=floor(charwd*hppp): w:=w+1; r:=r+1;
  541.  else: w:=w-1; r:=r-1; fi fi enddef;
  542. def padded expr del_sharp =
  543.  charht:=charht+del_sharp; chardp:=chardp+del_sharp enddef;
  544.  
  545. def font_setup =
  546.  if monospace: let adjust_fit=mono_adjust_fit;
  547.   if true_mono: let normal_adjust_fit=mono_adjust_fit; fi
  548.   def mfudged=fudged enddef;
  549.   mono_charic#:=body_height#*slant;
  550.   if mono_charic#<0: mono_charic#:=0; fi
  551.   mono_charwd#:=9u#; define_whole_pixels(mono_charwd);
  552.  else: let adjust_fit=normal_adjust_fit;
  553.   def mfudged= enddef; fi
  554.  if math_fitting: let math_fit=do_math_fit
  555.  else: let math_fit=ignore_math_fit fi;
  556.  define_pixels(u,width_adj,serif_fit,cap_serif_fit,jut,cap_jut,beak,
  557.   bar_height,dish,bracket,beak_jut,stem_corr,vair_corr,apex_corr);
  558.  define_blacker_pixels(notch_cut,cap_notch_cut);
  559.  forsuffixes $=notch_cut,cap_notch_cut: if $<3: $:=3; fi endfor
  560.  define_whole_pixels(letter_fit,fine,crisp,tiny);
  561.  define_whole_vertical_pixels(body_height,asc_height,
  562.   cap_height,acc_height,fig_height,x_height,comma_depth,desc_depth,serif_drop);
  563.  define_whole_blacker_pixels(thin_join,hair,stem,curve,flare,
  564.   dot_size,cap_hair,cap_stem,cap_curve);
  565.  define_whole_vertical_blacker_pixels(vair,bar,slab,cap_bar,cap_band);
  566.  define_corrected_pixels(o,apex_o);
  567.  forsuffixes $=hair,stem,cap_stem:
  568.   fudged$.#:=fudge*$.#; fudged$:=hround(fudged$.#*hppp+blacker);
  569.   forever: exitif fudged$>.9fudge*$; fudged$:=fudged$+1; endfor endfor
  570.  rule_thickness:=ceiling(rule_thickness#*hppp);
  571.  heavy_rule_thickness:=ceiling(3rule_thickness#*hppp);
  572.  oo:=vround(.5o#*hppp*o_correction)+eps;
  573.  apex_oo:=vround(.5apex_o#*hppp*o_correction)+eps;
  574.  lowres_fix(stem,curve,flare) 1.3;
  575.  lowres_fix(stem,curve) 1.2;
  576.  lowres_fix(cap_stem,cap_curve) 1.2;
  577.  lowres_fix(hair,cap_hair) 1.2;
  578.  lowres_fix(cap_band,cap_bar,bar,slab) 1.2;
  579.  stem':=hround(stem-stem_corr); cap_stem':=hround(cap_stem-stem_corr);
  580.  vair':=vround(vair+vair_corr);
  581.  vstem:=vround .8[vair,stem]; cap_vstem:=vround .8[vair,cap_stem];
  582.  ess:=(ess#/stem#)*stem; cap_ess:=(cap_ess#/cap_stem#)*cap_stem;
  583.  dw:=(curve#-stem#)*hppp; bold:=curve#*hppp+blacker;
  584.  dh#:=.6designsize;
  585.  stem_shift#:=if serifs: 2stem_corr# else: 0 fi;
  586.  more_super:=max(superness,sqrt .77superness);
  587.  hein_super:=max(superness,sqrt .81225258superness); % that's $2^{-.3}$
  588.  clear_pen_memory;
  589.  if fine=0: fine:=1; fi
  590.  forsuffixes $=fine,crisp,tiny:
  591. %%% fine $ %%%% temporary formatting convention for MFT
  592.   if $>fudged.hair: $:=fudged.hair; fi
  593.   $.breadth:=$;
  594.   pickup if $=0: nullpen else: pencircle scaled $; $:=$-eps fi;
  595.   $.nib:=savepen; breadth_[$.nib]:=$;
  596.   forsuffixes $$=lft,rt,top,bot: shiftdef($.$$,$$ 0); endfor endfor
  597. %%% @ $ %%%% restore ordinary formatting for $
  598.  min_Vround:=max(fine.breadth,crisp.breadth,tiny.breadth);
  599.  if min_Vround<vround min_Vround: min_Vround:=vround min_Vround; fi
  600.  if flare<vround flare: flare:=vround flare; fi
  601.  forsuffixes $=vair,bar,slab,cap_bar,cap_band,vair',vstem,cap_vstem,bold:
  602.   if $<min_Vround: $:=min_Vround; fi endfor
  603.  pickup pencircle scaled min(hair,vair); extra_rule.nib :=savepen;
  604.  pickup pencircle scaled rule_thickness; rule.nib:=savepen;
  605.  math_axis:=good.y(math_axis#*hppp);
  606.  pickup pencircle scaled if hefty:(.6[vair,fudged.hair]) else:fudged.hair fi;
  607.  light_rule.nib:=savepen;
  608.  currenttransform:=identity slanted slant
  609.   yscaled aspect_ratio scaled granularity;
  610.  if currenttransform=identity: let t_=relax
  611.  else: def t_ = transformed currenttransform enddef fi;
  612.  numeric paren_depth#; .5[body_height#,-paren_depth#]=math_axis#;
  613.  numeric asc_depth#; .5[asc_height#,-asc_depth#]=math_axis#;
  614.  body_depth:=desc_depth+body_height-asc_height;
  615.  shrink_fit:=1+hround(2letter_fit#*hppp)-2letter_fit;
  616.  if not string mode: if mode<=smoke: shrink_fit:=0; fi fi
  617.  enddef;
  618.  
  619. def shiftdef(suffix $)(expr delta) =
  620.  vardef $ primary x = x+delta enddef enddef;
  621.  
  622. def makebox(text rule) =
  623.  for y=0,(cap_height+acc_height),
  624.        asc_height,body_height,x_height,bar_height,-desc_depth,-body_depth:
  625.   rule((l,y)t_,(r,y)t_); endfor % horizontals
  626.  
  627.  for y=-3.5pt,8.5pt,(x_height+acc_height):
  628.    rule((l-4pt,y)t_,(l-2pt,y)t_); endfor
  629.  for x=l,r:   rule((x,-body_depth)t_,(x,body_height)t_); endfor % verticals
  630.  for x=u*(1+floor(l/u)) step u until r-1:
  631.   rule((x,-body_depth)t_,(x,body_height)t_); endfor % more verticals
  632.  
  633.  for x=0.5w:
  634.    rule((x,-body_depth-1pt)t_,(x,-body_depth-1.5pt)t_);
  635.    rule((x,cap_height+acc_height+1pt)t_,(x,cap_height+acc_height+1.5pt)t_);
  636.  endfor
  637.  if charic<>0:
  638.   rule((r+charic*pt,h.o_),(r+charic*pt,.5h.o_)); fi % italic correction
  639.  enddef;
  640. def maketicks(text rule) =
  641.  for y=0,h.o_,-d.o_:
  642.   rule((l,y),(l+10,y)); rule((r-10,y),(r,y)); endfor % horizontals
  643.  for x=l,r:
  644.   rule((x,10-d.o_),(x,-d.o_)); rule((x,h.o_-10),(x,h.o_)); endfor % verticals
  645.  if charic<>0:
  646.   rule((r+charic*pt,h.o_-10),(r+charic*pt,h.o_)); fi % italic correction
  647.  enddef;
  648. rulepen:=pensquare;
  649.  
  650. vardef stroke text t =
  651.  forsuffixes e = l,r: path_.e:=t; endfor
  652.  if cycle path_.l:
  653.   errmessage "Beware: `stroke' isn't intended for cycles"; fi
  654.  path_.l -- reverse path_.r -- cycle enddef;
  655.  
  656. vardef circ_stroke text t =
  657.  forsuffixes e = l,r: path_.e:=t; endfor
  658.  if cycle path_.l:
  659.   errmessage "Beware: `stroke' isn't intended for cycles"; fi
  660.  path_.l -- reverse path_.r .. cycle enddef;
  661.  
  662. vardef super_arc.r(suffix $,$$) = % outside of super-ellipse
  663.  pair center,corner;
  664.  if y$=y$r: center=(x$$r,y$r); corner=(x$r,y$$r);
  665.  else: center=(x$r,y$$r); corner=(x$$r,y$r); fi
  666.  z$.r{corner-z$.r}...superness[center,corner]{z$$.r-z$.r}
  667.   ...{z$$.r-corner}z$$.r enddef;
  668.  
  669. vardef super_arc.l(suffix $,$$) = % inside of super-ellipse
  670.  pair center,corner;
  671.  if y$=y$r: center=(x$$l,y$l); corner=(x$l,y$$l);
  672.  else: center=(x$l,y$$l); corner=(x$$l,y$l); fi
  673.  z$l{corner-z$l}...superness[center,corner]{z$$l-z$l}
  674.   ...{z$$l-corner}z$$l enddef;
  675.  
  676. vardef pulled_super_arc.r(suffix $,$$)(expr superpull) =
  677.  pair center,corner;
  678.  if y$=y$r: center=(x$$r,y$r); corner=(x$r,y$$r);
  679.  else: center=(x$r,y$$r); corner=(x$$r,y$r); fi
  680.  z$r{corner-z$r}...superness[center,corner]{z$$r-z$r}
  681.   ...{z$$r-corner}z$$r enddef;
  682.  
  683. vardef pulled_super_arc.l(suffix $,$$)(expr superpull) =
  684.  pair center,corner,outer_point;
  685.  if y$=y$r: center=(x$$l,y$l); corner=(x$l,y$$l);
  686.   outer_point=superness[(x$$r,y$r),(x$r,y$$r)];
  687.  else: center=(x$l,y$$l); corner=(x$$l,y$l);
  688.   outer_point=superness[(x$r,y$$r),(x$$r,y$r)]; fi
  689.  z$l{corner-z$l}
  690.   ...superpull[superness[center,corner],outer_point]{z$$l-z$l}
  691.   ...{z$$l-corner}z$$l enddef;
  692.  
  693. vardef pulled_arc@#(suffix $,$$) =
  694.  pulled_super_arc@#($,$$)(superpull) enddef;
  695.  
  696. vardef serif_arc(suffix $,$$) =
  697.  z${x$$-x$,0}...(.75[x$,x$$],.25[y$,y$$]){z$$-z$}...{0,y$$-y$}z$$ enddef;
  698.  
  699. vardef penpos@#(expr b,d) =
  700.  if known b: if b<=0:
  701.    errmessage "bad penpos (width is negative)"; fi fi
  702.  (x@#r-x@#l,y@#r-y@#l)=(b,0) rotated d;
  703.  x@#=.5(x@#l+x@#r); y@#=.5(y@#l+y@#r) enddef;
  704.  
  705. newinternal currentbreadth;
  706. vardef pos@#(expr b,d) =
  707.  if known b: if b<=currentbreadth:
  708.  errmessage "bad pos (breadth of current pen wider than pos width)"; fi fi
  709.  (x@#r-x@#l,y@#r-y@#l)=(b-currentbreadth,0) rotated d;
  710.  x@#=.5(x@#l+x@#r); y@#=.5(y@#l+y@#r) enddef;
  711. def numeric_pickup_ primary q =
  712.  currentpen:=pen_[q];
  713.  pen_lft:=pen_lft_[q];  pen_rt:=pen_rt_[q];
  714.  pen_top:=pen_top_[q];  pen_bot:=pen_bot_[q];
  715.  currentpen_path:=pen_path_[q];
  716.  if known breadth_[q]: currentbreadth:=breadth_[q]; fi enddef;
  717.  
  718. vardef ic# = charic enddef;
  719. vardef h# = charht enddef;
  720. vardef w# = charwd enddef;
  721. vardef d# = chardp enddef;
  722.  
  723. let {{=begingroup; let }}=endgroup;
  724. def .... = .. tension atleast .9 .. enddef;
  725. def less_tense = save ...; let ...=.... enddef;
  726. def ?? = hide(showvariable x,y) enddef;
  727.  
  728. let semi_ =;; let colon_ = :; let endchar_ = endchar;
  729. def iff expr b = if b:let next_=use_it else:let next_=lose_it fi; next_ enddef;
  730. def use_it = let : = restore_colon; enddef;
  731. def restore_colon = let : = colon_; enddef;
  732. def lose_it = let endchar=fi; inner ecchar; let ;=fix_ semi_ if false enddef;
  733. def fix_=let ;=semi_; let endchar=endchar_; outer ecchar; enddef;
  734. def always_iff = let : = endgroup; killboolean enddef;
  735. def killboolean text t = use_it enddef;
  736. outer ecchar;
  737.  
  738. %%% fine hi higher
  739. % |higher| is a counterpart to |lower| (see the file excsc.mf),
  740. % |hi| facilitates using higher values (which are reference points in
  741. % the floating world of CM fonts)
  742. def hi = if is_small_cap: higher fi\\ enddef;
  743.  
  744. %
  745. %  special routines for accenting
  746. %
  747. vardef uppercase_hat
  748.     (expr x_center,y_move,hat_zero,hat_one,hat_two,hat_three,hat_four) =
  749. if serifs:
  750.  pickup crisp.nib;
  751.  pos[hat_two](.5[vair,curve],90);
  752.  top y[hat_two]r=cap_accent_height+oo;
  753.  x[hat_two]=good.x x_center; %  optically centered
  754.  x[hat_one]=good.x x[hat_two]-2.25u if monospace: /expansion_factor fi ;
  755.  x[hat_three]=2x[hat_two]-x[hat_one];
  756. % |accent_gap| is defined by the acute accent, it is known when needed
  757.  y[hat_one]=y[hat_three] = accent_gap + cap_height;
  758.  pos[hat_one](hair,angle(z[hat_two]-z[hat_one])+90);
  759.  pos[hat_three](hair,angle(z[hat_three]-z[hat_two])+90);
  760.  filldraw stroke z[hat_one]e--z[hat_two]e--z[hat_three]e;  % diagonals
  761. else:
  762.  pickup fine.nib;
  763.  pos[hat_one](vair,0);
  764.  pos[hat_three](vair,0);
  765.  pos[hat_two](stem,0);
  766.  top y[hat_two]=cap_accent_height+oo;
  767.  x[hat_two]=good.x x_center; %  optically centered
  768.  x[hat_one]=good.x x[hat_two]-2.25u if monospace: /expansion_factor fi ;
  769.  x[hat_three]=2x[hat_two]-x[hat_one];
  770. % |accent_gap| is defined by the acute accent, it is known when needed
  771.  bot y[hat_one]=bot y[hat_three]=.5accent_gap + cap_height;
  772.  z[hat_zero]=whatever[z[hat_one]r,z[hat_two]r]=
  773.     whatever[z[hat_two]l,z[hat_three]l];
  774.  y[hat_four]l=y[hat_four]r=y[hat_two];
  775.  x[hat_four]l=good.x .2[x[hat_two]l,x[hat_two]];
  776.  x[hat_four]r=w-x[hat_four]l;
  777.  filldraw z[hat_four]l--z[hat_one]l--z[hat_one]r--
  778.     z[hat_zero]--z[hat_three]l--
  779.     z[hat_three]r--z[hat_four]r--cycle; fi  % diagonals
  780. enddef;
  781. %
  782. vardef lowercase_hat
  783.     (expr x_center,y_move,hat_zero,hat_one,hat_two,hat_three,hat_four) =
  784. if serifs:
  785.  pickup crisp.nib;
  786.  pos[hat_two](.5[vair,curve],90);
  787.  top y[hat_two]r=h+y_move;
  788.  x[hat_two]=good.x x_center; %  optically centered
  789.  x[hat_one]=good.x x[hat_two]-2.25u if monospace: /expansion_factor fi ;
  790.  x[hat_three]=2x[hat_two]-x[hat_one];
  791.  y[hat_one]=y[hat_three] =
  792.      max(y[hat_two]-0.5(min(asc_height,2x_height)-x_height),
  793.          1/6[x_height,h]);
  794.  pos[hat_one](hair,angle(z[hat_two]-z[hat_one])+90);
  795.  pos[hat_three](hair,angle(z[hat_three]-z[hat_two])+90);
  796.  filldraw stroke z[hat_one]e--z[hat_two]e--z[hat_three]e;  % diagonals
  797. else:
  798.  pickup fine.nib;
  799.  pos[hat_one](vair,0);
  800.  pos[hat_three](vair,0);
  801.  pos[hat_two](stem,0);
  802.  top y[hat_two]=h+y_move;
  803.  x[hat_two]=good.x x_center; %  optically centered
  804.  x[hat_one]=good.x x[hat_two]-2.25u if monospace: /expansion_factor fi ;
  805.  x[hat_three]=2x[hat_two]-x[hat_one];
  806.  bot y[hat_one]=bot y[hat_three]=vround (2/3[h,x_height]-eps);
  807.      % same slope as in the acute accent
  808.  z[hat_zero]=whatever[z[hat_one]r,z[hat_two]r]=
  809.     whatever[z[hat_two]l,z[hat_three]l];
  810.  y[hat_four]l=y[hat_four]r=y[hat_two];
  811.  x[hat_four]l=good.x .2[x[hat_two]l,x[hat_two]];
  812.  x[hat_four]r=w-x[hat_four]l;
  813.  filldraw z[hat_four]l--z[hat_one]l--z[hat_one]r--
  814.     z[hat_zero]--z[hat_three]l--
  815.     z[hat_three]r--z[hat_four]r--cycle; fi  % diagonals
  816. enddef;
  817. %
  818. %
  819. vardef lowercase_tilde(expr x_move,y_move,tilde_one,tilde_two,tilde_three,
  820.      tilde_four,tilde_five)=
  821. h':=min(asc_height,10/7x_height+.5dot_size);
  822. if serifs: numeric theta;
  823.  theta=angle(1/6(
  824.     6u if monospace: /expansion_factor fi-vair),
  825.       1/4(h'-x_height));
  826.  pickup crisp.nib;
  827.  numeric mid_width; mid_width=.4[vair,stem];
  828.  pos[tilde_one](vair,theta+90);
  829.  pos[tilde_two](vair,theta+90);
  830.  pos[tilde_three](vair,theta+90);
  831.  pos[tilde_four](vair,theta+90);
  832.  z[tilde_two]-z[tilde_one]=
  833.     z[tilde_four]-z[tilde_three]=(mid_width-crisp)*dir theta;
  834.  lft x[tilde_one]r=hround(x_move+0.5w-3u if monospace: /expansion_factor fi);
  835.  rt x[tilde_four]l=hround(x_move+0.5w+3u if monospace: /expansion_factor fi);
  836.  top y[tilde_four]r=h';
  837.  pair delta;
  838.  ypart delta=3(y[tilde_three]l-y[tilde_one]l);
  839.  delta=whatever*dir theta;
  840.  bot y[tilde_one]l=vround(bot y[tilde_one]l+
  841.     min(2/3[x_height,h'],y[tilde_three]l-.25vair)-top y[tilde_one]r);
  842.  filldraw z[tilde_one]l..
  843.    controls(z[tilde_one]l+
  844.     delta)and(z[tilde_three]l-delta)..z[tilde_three]l..z[tilde_four]l
  845.   --z[tilde_four]r..
  846.      controls(z[tilde_four]r-delta)and(z[tilde_two]r+delta)..
  847.      z[tilde_two]r..z[tilde_one]r--cycle;  % stroke
  848. else:
  849.  pickup fine.nib;
  850.  pos[tilde_one](vair,180);
  851.  pos[tilde_two](vair,90);
  852.  pos[tilde_three](.5[vair,slab],90);
  853.  pos[tilde_four](vair,90);
  854.  pos[tilde_five](vair,180);
  855.  lft x[tilde_one]r=hround (x_move + 0.5w-3u);
  856.  rt x[tilde_five]l=hround (x_move + 0.5w+3u);
  857.  x[tilde_two]-x[tilde_one]=
  858.     x[tilde_three]-x[tilde_two]=
  859.     x[tilde_four]-x[tilde_three]=x[tilde_five]-x[tilde_four];
  860.  bot y[tilde_one]=bot y[tilde_four]l=y_move+vround(.75[x_height,h]-vair);
  861.  top y[tilde_two]r=top y[tilde_five]=h+y_move;
  862.  y[tilde_three]=.5[y[tilde_two],y[tilde_four]];
  863.  filldraw stroke
  864.    z[tilde_one]e{up}...
  865.      z[tilde_two]e{right}..
  866.      z[tilde_three]e..
  867.      {right}z[tilde_four]e...{up}z[tilde_five]e; fi % stroke
  868. enddef;
  869.  
  870. %
  871. vardef uppercase_tilde(expr x_move,y_move,tilde_one,tilde_two,tilde_three,
  872.      tilde_four,tilde_five)=
  873. if serifs: numeric theta;
  874.  theta=angle(1/8(7u if monospace: /expansion_factor fi-vair),1/4acc_height);
  875.  pickup crisp.nib;
  876.  numeric mid_width; mid_width=.4[vair,stem];
  877.  pos[tilde_one](vair,theta+90);
  878.  pos[tilde_two](vair,theta+90);
  879.  pos[tilde_three](vair,theta+90);
  880.  pos[tilde_four](vair,theta+90);
  881.  z[tilde_two]-z[tilde_one]=
  882.     z[tilde_four]-z[tilde_three]=(mid_width-crisp)*dir theta;
  883.  lft x[tilde_one]r=hround(x_move+0.5w-3.5u if monospace: /expansion_factor fi);
  884.  rt x[tilde_four]l=hround(x_move+0.5w+3.5u if monospace: /expansion_factor fi);
  885.  top y[tilde_four]r=h;
  886. % |accent_gap| is defined by the acute accent, it is known when needed
  887. % bot y[tilde_one]l=accent_gap+cap_height;
  888.  bot y[tilde_one]l=vround(bot y[tilde_one]l
  889.     +min(2/3[cap_height,cap_accent_height],y[tilde_three]l-.25vair)
  890.     -top y[tilde_one]r);
  891.  pair delta;
  892.  ypart delta=3(y[tilde_three]l-y[tilde_one]l);
  893.  delta=whatever*dir theta;
  894.  filldraw z[tilde_one]l..
  895.    controls(z[tilde_one]l+
  896.     delta)and(z[tilde_three]l-delta)..z[tilde_three]l..z[tilde_four]l
  897.   --z[tilde_four]r..
  898.      controls(z[tilde_four]r-delta)and(z[tilde_two]r+delta)..
  899.      z[tilde_two]r..z[tilde_one]r--cycle;  % stroke
  900. else:
  901.  pickup fine.nib;
  902.  pos[tilde_one](vair,180);
  903.  pos[tilde_two](vair,90);
  904.  pos[tilde_three](.5[vair,slab],90);
  905.  pos[tilde_four](vair,90);
  906.  pos[tilde_five](vair,180);
  907.  lft x[tilde_one]r=w-rt x[tilde_five]l=hround 1.5u+0.5(w-9u);
  908.  x[tilde_two]-x[tilde_one]=
  909.     x[tilde_three]-x[tilde_two]=
  910.     x[tilde_four]-x[tilde_three]=x[tilde_five]-x[tilde_four];
  911. % |accent_gap| is defined by the acute accent, it is known when needed
  912.  bot y[tilde_one]=bot y[tilde_four]l=cap_height+.5accent_gap;
  913.  top y[tilde_two]r=top y[tilde_five]=h;
  914.  y[tilde_three]=.5[y[tilde_two],y[tilde_four]];
  915.  filldraw stroke
  916.    z[tilde_one]e{up}...
  917.      z[tilde_two]e{right}..
  918.      z[tilde_three]e..
  919.      {right}z[tilde_four]e...{up}z[tilde_five]e; fi % stroke
  920. enddef;
  921. %
  922. %
  923. %
  924. vardef lowercase_umlaut(expr x_move,y_move,umlaut_one,umlaut_two,
  925.    umlaut_three,umlaut_four) =
  926. pickup tiny.nib;
  927. pos[umlaut_one](udot_diam,0);
  928. pos[umlaut_two](udot_diam,90);
  929. x[umlaut_one]=x[umlaut_two]=x_move+.5w-1.75u if monospace:/expansion_factor fi ;
  930. top y[umlaut_two]r=lc_trema_height;
  931. y[umlaut_one]=y_move+.5[y[umlaut_two]l,y[umlaut_two]r];
  932. dot([umlaut_one],[umlaut_two]);  % left dot
  933. pos[umlaut_three](udot_diam,0);
  934. penpos[umlaut_four](y[umlaut_two]r-y[umlaut_two]l,90);
  935. y[umlaut_three]=y[umlaut_four]=y[umlaut_one];
  936. x[umlaut_three]=x[umlaut_four]=x[umlaut_one]
  937.      +3.5u if monospace: /expansion_factor fi ;
  938. dot([umlaut_three],[umlaut_four]);  % right dot
  939. enddef;
  940. %
  941. vardef uppercase_umlaut(expr x_move,y_move,umlaut_one,umlaut_two,
  942.    umlaut_three,umlaut_four) =
  943. pickup tiny.nib;
  944. pos[umlaut_one](udot_diam,0);
  945. pos[umlaut_two](udot_diam,90);
  946. x[umlaut_one]=x[umlaut_two]=x_move+.5w-1.75u if monospace:/expansion_factor fi ;
  947. top y[umlaut_two]r=vround(cap_height+dot_height#*hppp);
  948. y[umlaut_one]=y_move+.5[y[umlaut_two]l,y[umlaut_two]r];
  949. dot([umlaut_one],[umlaut_two]);  % left dot
  950. pos[umlaut_three](udot_diam,0);
  951. penpos[umlaut_four](y[umlaut_two]r-y[umlaut_two]l,90);
  952. y[umlaut_three]=y[umlaut_four]=y[umlaut_one];
  953. x[umlaut_three]=x[umlaut_four]=x[umlaut_one]
  954.      +3.5u if monospace: /expansion_factor fi ;
  955. dot([umlaut_three],[umlaut_four]);  % right dot
  956. enddef;
  957. %
  958. %
  959. vardef lowercase_circle(expr
  960.        x_center,y_bottom,circ_one,circ_two,circ_three,circ_four)=
  961. numeric circ_hair,circ_vair;
  962. circ_hair=hround min(hair,u if monospace: /expansion_factor fi +.5);
  963. circ_vair=vround min(vair,(h-x_height)/6+.5);
  964. penpos[circ_one](circ_vair,90); penpos[circ_three](circ_vair,-90);
  965. penpos[circ_two](circ_hair,180); penpos[circ_four](circ_hair,0);
  966. x[circ_one]=x[circ_three]=x_center; %
  967. x[circ_two]r=hround(x[circ_one]-1.5u-.5circ_hair);
  968. x[circ_four]r=hround(x[circ_one]+1.5u+.5circ_hair);
  969. y[circ_one]r=h+apex_o;
  970. y[circ_two]=y[circ_four]=.5[y[circ_one],y[circ_three]];
  971. y[circ_three]l=vround y_bottom; % (1/3[x_height,h]+apex_o);
  972. penstroke pulled_arc.e([circ_one],[circ_two])
  973.  & pulled_arc.e([circ_two],[circ_three])
  974.  & pulled_arc.e([circ_three],[circ_four])
  975.  & pulled_arc.e([circ_four],[circ_one]) & cycle;  % bowl
  976. enddef;
  977. %
  978. vardef uppercase_circle(expr
  979.        x_center,y_bottom,circ_one,circ_two,circ_three,circ_four)=
  980. numeric circ_hair,circ_vair;
  981. circ_hair=hround min(hair,u if monospace: /expansion_factor fi +.5);
  982. circ_vair=vround vair; % min(vair,(h-x_height)/6+.5);
  983. penpos[circ_one](circ_vair,90); penpos[circ_three](circ_vair,-90);
  984. penpos[circ_two](circ_hair,180); penpos[circ_four](circ_hair,0);
  985. x[circ_one]=x[circ_three]=x_center; % .5w;
  986. x[circ_two]r
  987.     = hround(x[circ_one]-1.5u if monospace: /expansion_factor fi -.5circ_hair);
  988. x[circ_four]r
  989.     = hround(x[circ_one]+1.5u if monospace: /expansion_factor fi +.5circ_hair);
  990. y[circ_one]r=cap_height + acc_height+apex_o;
  991. y[circ_two]=y[circ_four]=.5[y[circ_one],y[circ_three]];
  992. y[circ_three]l=vround y_bottom; % (1/3[x_height,h]+apex_o);
  993. penstroke pulled_arc.e([circ_one],[circ_two])
  994.  & pulled_arc.e([circ_two],[circ_three])
  995.  & pulled_arc.e([circ_three],[circ_four])
  996.  & pulled_arc.e([circ_four],[circ_one]) & cycle;  % bowl
  997. enddef;
  998. %
  999. %
  1000. vardef lowercase_cedilla (expr x_center,y_move,
  1001.    cedi_one,cedi_two,cedi_three,cedi_four,cedi_five) =
  1002. x[cedi_one]=x_center; % .5w+.5u;
  1003. if serifs:
  1004.  pickup crisp.nib;
  1005.  pos[cedi_one](stem,0);
  1006.  pos[cedi_two](stem,0);
  1007.  pos[cedi_three](vair,90);
  1008.  pos[cedi_four](stem,0);
  1009.  pos[cedi_five](vair,-90);
  1010.  x[cedi_one]=x[cedi_two];
  1011.  z[cedi_three]l=z[cedi_two]l;
  1012.  x[cedi_four]=x[cedi_two]+1.5u;
  1013.  x[cedi_five]=x[cedi_three]-1.5u;
  1014.  bot y[cedi_one]=0;
  1015.  bot y[cedi_two]=-vround 2/7d-o;
  1016.  y[cedi_four]=.5[y[cedi_three],y[cedi_five]];
  1017.  bot y[cedi_five]=-d-o;
  1018.  filldraw stroke z[cedi_one]e--z[cedi_two]e;  % stem
  1019.  filldraw stroke z[cedi_three]e{right}...
  1020.    z[cedi_four]e{down}...{left}z[cedi_five]e;  % hook
  1021. else: pickup fine.nib; pos[cedi_one](vair,0); top y[cedi_one]=-o-2;
  1022.  pos[cedi_two](.5[vair,stem],0);
  1023.  bot y[cedi_two]=-d-o; x[cedi_two]=x[cedi_one]-1.25u;
  1024.  filldraw stroke z[cedi_one]e--z[cedi_two]e; fi  % diagonal
  1025. enddef;
  1026. %
  1027. vardef uppercase_cedilla(expr x_center,y_move,
  1028.   cedi_one,cedi_two,cedi_three,cedi_four,cedi_five) =
  1029. x[cedi_one]=x_center;;
  1030. if serifs:
  1031.  pickup crisp.nib;
  1032.  pos[cedi_one](stem,0);
  1033.  pos[cedi_two](stem,0);
  1034.  pos[cedi_three](vair,90);
  1035.  pos[cedi_four](stem,0);
  1036.  pos[cedi_five](vair,-90);
  1037.  x[cedi_one]=x[cedi_two];
  1038.  z[cedi_three]l=z[cedi_two]l;
  1039.  x[cedi_four]=x[cedi_two]+1.5u if monospace: /expansion_factor fi;
  1040.  x[cedi_five]=x[cedi_three]-1.5u if monospace: /expansion_factor fi;
  1041.  top y[cedi_one]=y_move;
  1042.  bot y[cedi_two]=-vround 2/7d-o;
  1043.  y[cedi_four]=.5[y[cedi_three],y[cedi_five]];
  1044.  bot y[cedi_five]=-d-o;
  1045.  filldraw stroke z[cedi_one]e--z[cedi_two]e;  % stem
  1046.  filldraw stroke z[cedi_three]e{right}...
  1047.    z[cedi_four]e{down}...{left}z[cedi_five]e;  % hook
  1048. else: pickup fine.nib; pos[cedi_one](vair,0);
  1049.  top y[cedi_one]=-o-2;
  1050.  pos[cedi_two](.5[vair,stem],0);
  1051.  bot y[cedi_two]=-d-o; x[cedi_two] =
  1052.     x[cedi_one]-1.25u if monospace: /expansion_factor fi;
  1053.  filldraw stroke z[cedi_one]e--z[cedi_two]e; fi  % diagonal
  1054. enddef;
  1055. %
  1056. %
  1057. vardef lowercase_breve(expr x_center,y_move,breve_one,breve_two,breve_three)=
  1058. pickup crisp.nib; pos[breve_one](vair,-180);
  1059. pos[breve_three](vair,0);
  1060. top y[breve_one]=top y[breve_three]=h;
  1061. x[breve_two]=x_center;
  1062. lft x[breve_one]r=hround(x[breve_two]-2.5u
  1063.    if monospace: /expansion_factor fi -0.5vair);
  1064. rt x[breve_three]r=hround(x[breve_two]+2.5u
  1065.    if monospace: /expansion_factor fi +0.5vair);
  1066. numeric mid_thickness; mid_thickness=vround 1/3[vair,stem];
  1067. pos[breve_two](mid_thickness,-90);
  1068. bot y[breve_two]r=
  1069.    vround max(x_height+o+tiny,1/3[x_height,h]+o-.5mid_thickness);
  1070. filldraw stroke z[breve_one]e{down}...
  1071.          z[breve_two]e{right}...{up}z[breve_three]e;  % stroke
  1072. enddef;
  1073. %
  1074. vardef uppercase_breve (expr x_center,y_move,breve_one,
  1075.    breve_two,breve_three)=
  1076. pickup crisp.nib; pos[breve_one](vair,-180);
  1077. pos[breve_three](vair,0);
  1078. top y[breve_one]=top y[breve_three]=cap_height + acc_height;
  1079. x[breve_two]=hround x_center;
  1080. x[breve_two]-rt x[breve_one]l
  1081.   =(lft x[breve_three]l)-x[breve_two]
  1082.   =hround (2.5u if monospace: /expansion_factor fi -.5vair);
  1083. numeric mid_thickness;
  1084. mid_thickness=vround min(1/3[vair,stem],.5acc_height);
  1085. pos[breve_two](mid_thickness,-90);
  1086. % |accent_gap| is defined by the acute accent, it is known when needed
  1087. bot y[breve_two]r=cap_height + if hefty: .5 fi accent_gap;
  1088. filldraw stroke z[breve_one]e{down}...z[breve_two]e{right}...
  1089.      {up}z[breve_three]e;  % stroke
  1090. enddef;
  1091.  
  1092. %
  1093. vardef lowercase_ogonek(expr x_move,y_move,ogon_one,ogon_two,ogon_three) =
  1094. x[ogon_one]r=x_move;
  1095.  pickup crisp.nib;
  1096.  pos[ogon_one](
  1097.  if currentbreadth<0.9vair: 0.9vair else: currentbreadth+eps fi,-60);
  1098.  pos[ogon_two](stem,0);
  1099.  pos[ogon_three](vair,145);
  1100.  x[ogon_two]=x[ogon_one]-2.5u if monospace: / expansion_factor fi ;
  1101.  x[ogon_three]=x[ogon_one]+0.5u if monospace: / expansion_factor fi ;
  1102.  bot y[ogon_one]r = y_move;
  1103.  bot y[ogon_three]=0.5(-d-o)+y_move;  %0.4
  1104.  bot y[ogon_two]=0.5(-d-o)+y_move;
  1105.  filldraw stroke z[ogon_one]e{dir 225}...
  1106.    z[ogon_two]e{dir -110}...{dir 60}z[ogon_three]e;  % hook
  1107. enddef;
  1108.  
  1109. % ---------------------------------------------------------------------------
  1110. %                   MACROS FOR PROCESSING CHARS TWICE:
  1111. %             PASS 1: COLLECTING TFM (SHARP) INFORMATION
  1112. %             PASS 2: CREATING THE GLYPH
  1113. % ---------------------------------------------------------------------------
  1114. %%% define_pixels prepare_pen
  1115. %%% beginchar beginchar_twice
  1116. %%% endfor repeat_once
  1117.  
  1118. % A special provision is necessary if one uses |modes.mf|:
  1119. % This file assumes, that one never wants to use more than one mode
  1120. % in the same font, but we will do so.
  1121. %
  1122. % Make sure, that you never input |modes.mf| after this file, otherwise
  1123. % unpleasant surprises wait for you.
  1124.  
  1125. def clear_mode_guards =
  1126.   forsuffixes $=proofing,fontmaking,tracingtitles,pixels_per_inch,
  1127.     blacker,fillin,o_correction,blacker_min,aspect_ratio:
  1128.       numeric mode_guard_$;
  1129.   endfor
  1130. enddef;
  1131.  
  1132. let ori_draw:=draw;
  1133. let ori_fill:=fill;
  1134. let ori_filldraw:=filldraw;
  1135. let ori_erase:=erase;
  1136. let ori_penstroke:=penstroke;
  1137. let ori_special:=special;
  1138. let ori_numspecial:=numspecial;
  1139.  
  1140. mode_def canonical_sharp_mode = % nearly |proof| mode
  1141.  proofing:=0;                   % no, we aren't making full proofs
  1142.  fontmaking:=0;                 % yes, we are making a font
  1143.  tracingtitles:=0;              % don't show titles online
  1144.  pixels_per_inch:=2601.72;      % that's 36 pixels per pt
  1145.  blacker:=0;                    % no additional blackness
  1146.  blacker_min:=0;                % no write_white provision
  1147.  fillin:=0;                     % no compensation for fillin
  1148.  o_correction:=1;               % no reduction in overshoot
  1149. enddef;
  1150.  
  1151. def beginchar_twice(expr c,w_sharp,h_sharp,d_sharp) =
  1152.  begingroup
  1153.   if string mode: string prev_mode; prev_mode:=mode;
  1154.   else: numeric prev_mode; prev_mode:=mode;
  1155.   fi
  1156.   for sharp_calc_:=1,whatever:
  1157. %  |sharp_calc| is checked in |corrital|, |mark_height|, and |put_accent|
  1158.    sharp_calc:=sharp_calc_;
  1159.    if known sharp_calc: % carry out ``sharp'' calculations
  1160.     begingroup save mode,mag; mode:=canonical_sharp_mode; 
  1161.     clear_mode_guards; mode_setup; font_setup; pseudo_setup;
  1162.     if is_small_cap: % excerpt from |font_setup|
  1163.       define_pixels(higher.u,higher.bar_height);
  1164.       define_corrected_pixels(higher.o);
  1165.       define_whole_pixels(higher.letter_fit);
  1166.       define_whole_vertical_pixels(higher.x_height,higher.body_height);
  1167.       define_whole_blacker_pixels(higher.stem);
  1168.     fi
  1169.     endgroup;
  1170.     def draw expr e=enddef;
  1171.     let fill:=draw;
  1172.     let filldraw:=draw;
  1173.     let erase:=killtext; % |killtext| was absent from earlier versions of plain
  1174.     let penstroke:=killtext;
  1175.     def special primary t = enddef;
  1176.     def numspecial primary t = enddef;
  1177.     charwd:=w_sharp; charht:=h_sharp; chardp:=d_sharp; charic:=0;
  1178.    else: % carry out ``discrete'' calculations
  1179.     mode:=prev_mode; 
  1180.     clear_mode_guards; mode_setup; font_setup; pseudo_setup;
  1181.     if is_small_cap: % excerpt from |font_setup|
  1182.       define_pixels(higher.u,higher.bar_height);
  1183.       define_corrected_pixels(higher.o);
  1184.       define_whole_pixels(higher.letter_fit);
  1185.       define_whole_vertical_pixels(higher.x_height,higher.body_height);
  1186.       define_whole_blacker_pixels(higher.stem);
  1187.     fi
  1188.     let draw:=ori_draw;
  1189.     let fill:=ori_fill;
  1190.     let filldraw:=ori_filldraw;
  1191.     let erase:=ori_erase;
  1192.     let penstroke:=ori_penstroke;
  1193.     let special:=ori_special;
  1194.     let numspecial:=ori_numspecial;
  1195.     charwd:=w_sharp;
  1196.    fi
  1197.    charcode:=if known c: byte c else: 0 fi;
  1198.    w:=hround(w_sharp*hppp); h:=vround(h_sharp*hppp); d:=vround(d_sharp*hppp);
  1199.    clearxy; clearit; clearpen; scantokens extra_beginchar;
  1200. enddef;
  1201.  
  1202. let repeat_once = endfor;
  1203.  
  1204. % ---------------------------------------------------------------------------
  1205. %
  1206. %
  1207. %
  1208. % some extra font parameters
  1209. %
  1210. def font_cap_height expr x = fontdimen 8: x enddef;
  1211. def font_asc_height expr x = fontdimen 9: x enddef;
  1212. def font_acc_cap_height expr x = fontdimen 10: x enddef;
  1213. def font_desc_depth expr x = fontdimen 11: x enddef;
  1214. def font_max_height expr x = fontdimen 12: x enddef;
  1215. def font_max_depth  expr x = fontdimen 13: x enddef;
  1216. def font_digit_width expr x = fontdimen 14: x enddef;
  1217. def font_cap_stem expr x = fontdimen 15: x enddef;
  1218. def font_baselineskip  expr x = fontdimen 16: x enddef;
  1219.  
  1220.  
  1221.  
  1222. %
  1223. %      XXXXXXX       The following routines generate the parameter
  1224. %      X     X       sets by extrapolation
  1225. %      X     X
  1226. %      X     X
  1227. %      X     X
  1228. %   XXXX     XXXX
  1229. %    X         X
  1230. %     X       X
  1231. %      X     X
  1232. %       X   X
  1233. %        X X
  1234. %         X
  1235. %
  1236. %
  1237. %                     needed variables
  1238. %
  1239.  
  1240. vardef simple_gendef@#(text aa)(text t)=
  1241.  string s[];
  1242.  s1:="";
  1243.  s2:=str @#;
  1244.  index:=1;
  1245.  forsuffixes $=t: ydata[index]:=$ if s1<>s2: *@# fi;
  1246.                  index:=index+1;
  1247.  endfor;
  1248.  if numpoints>(index-1): errmessage "Missing parameter"; message str aa; fi;
  1249.  if numpoints<(index-1): errmessage "Too many parameters"; message str aa; fi;
  1250.  aa:=ydata[merke];
  1251.  if gencheck: message str aa fi;
  1252. enddef;
  1253.  
  1254. vardef extended_gendef@#(text aa)(text t)=
  1255.  string s[];
  1256.  s1:="";
  1257.  s2:=str @#;
  1258.  index:=1;
  1259.  forsuffixes $=t: ydata[index]:=$ if s1<>s2: *@# fi;
  1260.                  index:=index+1;
  1261.  endfor;
  1262.  if numpoints>(index-1): errmessage "Missing parameter"; message str aa; fi;
  1263.  if numpoints<(index-1): errmessage "Too many parameters"; message str aa; fi;
  1264.  if gensize>basedata[numpoints]:
  1265.    numeric hilf [];
  1266.    hilf[1]:=(ydata[numpoints]-ydata[numpoints-1])/(basedata[numpoints]-basedata[numpoints-1]);
  1267.    hilf[2]:=(ydata[numpoints]-ydata[numpoints-2])/(basedata[numpoints]-basedata[numpoints-2]);
  1268.    hilf[3]:=ydata[numpoints]-hilf1*basedata[numpoints];
  1269.    hilf[4]:=ydata[numpoints]-hilf2*basedata[numpoints];
  1270.    spy:=(hilf[1]*gensize+hilf[3])/2+(hilf[2]*gensize+hilf[4])/2;
  1271.    aa:=spy;
  1272.  else:
  1273.  for index = 1 upto numpoints-1:
  1274.     interval[index]:=basedata[index+1]-basedata[index];
  1275.  endfor;
  1276.  for index=1 upto numpoints:
  1277.     spline[1][index]:=ydata[index];
  1278.  endfor;
  1279.  for index=2 upto numpoints-1:
  1280.     alpha[index]:=3*((spline[1][index+1]*interval[index-1])%
  1281.                    -(spline[1][index]*(basedata[index+1]-basedata[index-1]))%
  1282.                    +(spline[1][index-1]*interval[index]))%
  1283.                    /(interval[index-1]*interval[index]);
  1284.  endfor;
  1285.  spl[1]:=0;
  1286.  spmu[1]:=0;
  1287.  spz[1]:=0;
  1288.  for index=2 upto numpoints-1:
  1289.     spl[index]:=2*(basedata[index+1]-basedata[index-1])%
  1290.                  -interval[index-1]*spmu[index-1];
  1291.     spmu[index]:=interval[index]/spl[index];
  1292.     spz[index]:=(alpha[index]-interval[index-1]*spz[index-1])/spl[index];
  1293.  endfor;
  1294.  spline[3][numpoints]:=0;
  1295.  for index=numpoints-1 downto 1:
  1296.     spline[3][index]:=spz[index]-spmu[index]*spline[3][index+1];
  1297.  endfor;
  1298.  for index=numpoints -1 downto 1:
  1299.     spline[2][index]:=(spline[1][index+1]-spline[1][index])/interval[index]%
  1300.              -interval[index]*(spline[3][index+1]*spline[3][index])/3;
  1301.     spline[4][index]:=(spline[3][index+1]-spline[3][index])/(3*interval[index]);
  1302.  endfor;
  1303.  location:=1;
  1304.  for term=1 upto numpoints-1:
  1305.     if gensize > basedata[term]: location:=term; fi
  1306.  endfor;
  1307.  spx:=gensize-basedata[location];
  1308.  spy:=((spline[4][location]*spx+spline[3][location])*spx+spline[2][location])*spx+spline[1][location];
  1309.  aa:=spy; fi;
  1310.  if gencheck: message str aa fi;
  1311. enddef;
  1312.  
  1313. vardef basedef(text t)=
  1314.  boolean basevalue; boolean gencheck;
  1315.  numeric index; numeric ergbnis; numeric location; numeric term;
  1316.  numeric numpoints; numeric spx; numeric spy;
  1317.  numeric basedata[]; numeric interval[]; numeric alpha[];
  1318.  numeric spl[]; numeric spmu[]; numeric spz[];
  1319.  numeric ydata[]; numeric spline[][];
  1320.  basevalue:=false; gencheck:=false;
  1321.  index:=1;
  1322.  forsuffixes $=t: basedata[index]:=$;
  1323.                  if $=gensize: basevalue:=true; merke:=index; fi;
  1324.                  index:=index+1;
  1325.  endfor;
  1326.  numpoints:=index-1;
  1327.  if numpoints<3: errmessage "Not enough reference points"; fi
  1328.  if basevalue: def gendef=simple_gendef enddef; else:
  1329.                def gendef=extended_gendef enddef; fi
  1330. enddef;
  1331.  
  1332. def clear_extra_memory= % Release ressources hold by the extrapolation routine
  1333.  numeric index; numeric ergbnis; numeric location; numeric term;
  1334.  numeric numpoints; numeric spx; numeric spy;
  1335.  numeric basedata[]; numeric interval[]; numeric alpha[];
  1336.  numeric spl[]; numeric spmu[]; numeric spz[];
  1337.  numeric ydata[]; numeric spline[][];
  1338.  numeric hilf []; string s[];
  1339. enddef;
  1340.  
  1341. endinput;
  1342.